home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0054_Record Locking with Share.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  2.4 KB  |  111 lines
  1. {
  2. You may be unlocking the records incorrectly, it may be your system, or
  3. it may be bad code (I only found one good proc in AllSwags and that
  4. needed some tweaking to get it to work right).  Here is a program that
  5. has been tested and works fine, I had ~7 copies running at once under
  6. Win95 and it was still pretty fast:
  7.  
  8. {NOTE: IT generates the dat file if one is not found}
  9.  
  10. {$M 4000, 0,0}
  11.  
  12. program Test;
  13.  
  14. uses Crt;
  15.  
  16. const
  17.   {File mode def's}
  18.   fmReadOnly  = $00;
  19.   fmWriteOnly = $01; {Use one of these}
  20.   fmReadWrite = $02;
  21.  
  22.   fmDenyAll   = $10; {with one of these}
  23.   fmDenyWrite = $20;
  24.   fmDenyRead  = $30;
  25.   fmDenyNone  = $40;
  26.  
  27. type
  28.   LockAction = (Lock, Unlock);
  29.  
  30. var
  31.   Err: Integer;
  32.   Timer: Longint absolute $40:$6C;
  33.   Buffer: array[0..4991] of byte;
  34.   Data: array[0..127] of byte;
  35.   F: file;
  36.   I: Integer;
  37.   FPos: Longint;
  38.  
  39. function ShareIn: Boolean; assembler;
  40. asm
  41.   mov ax, 1000h  {Test for share}
  42.   int 2fh        {Call multiplex interrupt}
  43.   cmp al, 0ffh   {ShareIn = AL=$FF}
  44.   xor al, al     {Default is false}
  45.   jne @@Done     {False}
  46.   mov al, 01h    {True}
  47. @@Done:
  48.   mov ax, 01h
  49. end;
  50.  
  51. function FLock(var F; Action: LockAction; FPos,Len: Longint): Word;
  52.   assembler;
  53. asm
  54.   je @@End
  55.   mov al, Action  {0=Lock,1=Unlock}
  56.   mov ah, $5C     {Dos lock function}
  57.   les si, F       {Load F}
  58.   mov bx, es:[si] {Get file handle}
  59.   les dx, Fpos
  60.   mov cx, es      {CX:DI=Begin position}
  61.   les di, len
  62.   mov si, es      {SI:DI length lock area}
  63.   int 21h         {MS-DOS}
  64.   jc @@End        {If error, return AX}
  65.   xor ax, ax      {Else, return 0}
  66. @@End:
  67. end;
  68.  
  69. begin
  70.   if not ShareIn then
  71.   begin
  72.     Writeln('Either run under Win95 or install SHARE');
  73.     Exit;
  74.   end;
  75.   {$I-}
  76.   assign(F, 'Test.dat');
  77.   filemode := fmDenyNone and fmReadWrite;
  78.   Reset(F,128);
  79.   if IOResult = 2 then
  80.   begin
  81.     FileMode := $02;
  82.     Rewrite(F, 1);
  83.     BlockWrite(F,Buffer,SizeOf(Buffer));
  84.     Close(F);
  85.     FileMode := fmDenyNone + fmReadWrite;
  86.     Reset(F,128);
  87.   end;
  88.   {$I+}
  89.   repeat
  90.     I := 0;
  91.   while not EOf(F) do
  92.   begin
  93.     inc(I);
  94.     FPos := FilePos(F);
  95.     repeat
  96.       Err := Flock(F,Lock,FPos,FPos+SizeOf(Data));
  97.     until Err <> 33;
  98.     if Err <> 0 then
  99.     begin
  100.       Writeln('Error locking!');
  101.       Halt;
  102.     end;
  103.     BlockRead(F, Data, 1);
  104.     Flock(F,unLock,FPos,FPos+SizeOf(Data));
  105.     Writeln(I);
  106.   end;
  107.   Seek(F,0);
  108.   until KeyPressed;
  109.   Close(F);
  110. end.
  111.